perm filename PX.F4[RST,LCS] blob
sn#092599 filedate 1974-03-20 generic text, type T, neo UTF8
00100 SUBROUTINE PLOU(NEWEND)
00110 COMMON/JOMMAC/ILINE,JLINE,KSIDE,MSIDE,NEWZ
00200 COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
00300 1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
00400 C KA-D IS FOR INVIS. INNER AREA. IA-D IS FOR INVIS. OUTER AREA.
00500
00510 COMMON/DRW/JDRW(2000)/FU/FUJ(512),JJX,RDIV,ADML
00555 EQUIVALENCE(JDRW,INP)
00600 COMMON/DDP/IDP1(4000)
00650 DIMENSION INP(10,200)
00700 COMMON/MEDGE/MC,MD,RMC,MMD/CLR/KP,KQ,KR,KS,P
00900 COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000 1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100 INTEGER FLINE,RSIDE
01200 DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/,RTO/6./,BITS/4/
01210 NEWEND=NEWZ
01250 IF(NEWEND.EQ.0)RETURN
01300 IF(NEWEND)GO TO 6002
01400 IF(NEWX)GO TO 1
01600 FLINE=ILINE
01700 LLINE=JLINE
01800 LSIDE=KSIDE
01900 RSIDE=MSIDE
02000 NX=0
02100 NY=0
02200
02300 1001 FORMAT(A1,3F)
02400 1000 FORMAT(' D, P, S, M OR T HORZ.%,VRT.%, ROTATION'/)
02500 6100 FORMAT(' INNER CLEAR AREA L-R-BT-TP% OUTER L-R-B-T%
02600 1 REV=1, INV=1 2ND INNER CLR'/)
02700 6001 FORMAT(14F)
02800 1 CALL JZERO
02900 JX=0
03000 JY=0
03100 CONST=0
03200 TYPE 1000
03300 ACCEPT 1001,WHICH,RLR,RUD,ROT
03350 IF(WHICH.EQ.'R')RETURN
03360 IF(WHICH.NE.'C')GO TO 24
03365 NEWX=0
03370 GO TO 1
03375 C TYPE 'R' TO GO BACK TO FILE TYPE-IN.
03400 CC IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
03450 24 NCNT=NCNT+1
03500 REREAD 3,(INP(NA,NCNT),NA=1,10)
03800 IF(WHICH.NE.'H')GO TO 8002
03900 TYPE 9002
04000 GO TO 1
04100 9002 FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
04200 1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
04300 8002 IF(WHICH.NE.'T')GO TO 3002
04310 6002 TYPE 91,RDIV,JJX
04320 91 FORMAT(' CENTR=',F6.2,' STEP=',I2)
04400 DO 4002 K=1,NCNT
04500 4002 TYPE 5002,(INP(NA,K),NA=1,10)
04600 IF(NEWEND)RETURN
04700 GO TO 1000
04705 3002 IF(WHICH.EQ.'M')GO TO 3102
04710 TYPE 6100
04720 ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
04730 C TYPE -1 TO REPEAT LAST INPUT
04735 IF(A.GE.0)GO TO 33
04740 C REPEATS LAST INPUT
04745 A=AA
04750 B=BB
04755 C=CC
04760 D=DD
04765 E=EE
04770 F=FF
04775 G=GG
04780 H=HH
04785 REV=RREV
04790 RINV=RRINV
04795 P=PP
04800 Q=QQ
04805 R=RR
04810 S=SS
04815 33 AA=A
04820 BB=B
04825 CC=C
04830 DD=D
04835 EE=E
04840 FF=F
04845 GG=G
04850 HH=H
04855 RREV=REV
04860 RRINV=RINV
04865 SS=S
04870 PP=P
04875 QQ=Q
04880 RR=R
04890 IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
04900 REREAD 3,(INP(NA,NCNT),NA=1,10)
05000 3102 JPL=3
05100 WX=WHICH
05200 C SO IT WON'T COUNT RETRIES.
05300 3 FORMAT(10A5)
05400 5002 FORMAT(1X10A5)
05500 C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
05600 C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
05700 C TYPE 'T' TO GET BACK ALL INPUT LINES.
05800 IF(A+B+C+D.EQ.0)A=-1.
05900 C 'N'= PLOT, BUT NO X
06000 IF(WHICH.NE.'S')GO TO 7002
06100 WHICH='P'
06200 CONST=-1
06300 7002 IF(WHICH.EQ.'M')GO TO 2002
06400 IF(E+H+F+G.EQ.0)E=-1.
06410 IF(P+Q+R+S.EQ.0)P=-1.
06500 IF(RLR.EQ.0)RLR=100.
06600 IF(RUD.EQ.0)RUD=100.
06700 IF(ROT.EQ.1)RINV=RINV-1
06800 2002 RLR=RLR/100.
06900 RUD=RUD/100.
07000 PLT=0
07100 IF(WHICH.NE.'D')GO TO 1002
07200 C DPY IS 1/3 SIZE OF PLOT.
07300 GO TO 2000
07400
07500 1102 IF(WHICH.NE.'M')GO TO 1
07600 C MOVE PEN, L-R%, U-D
07700 2200 RX=JMC
07800 RY=JMD
07900 NX=RX*RLR
08000 NY=RY*RUD
08100 RLR=.01
08200 RUD=.01
08300 GO TO 67
08400
08500 1002 IF(WHICH.NE.'P')GO TO 1102
08600 PLT=1
08700
08800 2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
08900 67 MA=0
09000 MB=0
09100 MC=(RSIDE-LSIDE)*RTO*RLR+.5
09200 MD=(LLINE-FLINE)*RTO*RUD+.5
09210 JREV=MC/JPL
09255 JINV=MD/JPL
09300 JM=-380
09400 KM=-200
09500 IF(NEWX)GO TO 655
09600 JMC=MC
09700 JMD=MD
09800 655 JQX=NX
09900 JQY=NY
10000 IF(WHICH.EQ.'M')GO TO 671
10700 KA=0
10800 KB=0
10900 KC=0
11000 KD=0
11010 KP=0
11032 KQ=0
11054 KR=0
11076 KS=0
11100 IA=-1
11200 IB=99999
11300 IC=-1
11400 ID=99999
12100 671 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
12200 CALL SETPOG(1)
12300 CALL TYPLOC(-300,-611)
12400 CALL DPYBRT(6)
12500 JX=NX/JPL
12600 JY=NY/JPL
12700 CALL AIVECT(-380,-200)
12800 672 JA=0
12900 JB=0
13000 NC=MC/JPL
13100 ND=MD/JPL
13150 CALL DSTORT(JPL)
13200 CALL LINES(3)
13400 JA=NC
13500 JB=0
13600 CALL LINES(2)
13700 JA=NC
13800 JB=ND
13900 CALL LINES(2)
14000 JB=ND
14100 JA=0
14200 CALL LINES(2)
14300 JA=0
14400 JB=0
14500 CALL LINES(2)
14600 CALL DPYOUT(1)
14700 IF(WHICH.NE.'M')GO TO 2683
14800 168 NY=JQY
14900 NX=JQX
15000 GO TO 1
15100 2683 NQ=0
15200 IF(A)GO TO 1683
15300 KA=MC*(A/100.)
15400 KB=MC*(B/100.)
15500 KC=MD*(C/100.)
15600 KD=MD*(D/100.)
15800 CALL INVIS(KA,KB,KC,KD,NQ)
16000 1683 IF(P)GO TO 9683
16055 KP=MC*(P/100.)
16110 KQ=MC*(Q/100.)
16165 KR=MD*(R/100.)
16220 KS=MD*(S/100.)
16275 CALL INVIS(KP,KQ,KR,KS,NQ)
16330 9683 IF(E)GO TO 8683
16385 IA=MC*(E/100.)
16440 IB=MC*(F/100.)
16495 IC=MD*(G/100.)
16550 ID=MD*(H/100.)
16605 CALL INVIS(IA,IB,IC,ID,NQ)
16660 IF(PLT.EQ.0)E=-1
16715 8683 IF(PLT.NE.0)JPL=1
16770 KA=KA/JPL
16825 KB=KB/JPL
16880 KC=KC/JPL
16935 KD=KD/JPL
16990 KP=KP/JPL
17045 KQ=KQ/JPL
17100 KR=KR/JPL
17155 KS=KS/JPL
17210 IA=IA/JPL
17232 IB=IB/JPL
17254 IC=IC/JPL
17276 ID=ID/JPL
17300 TYPE 683
17400 683 FORMAT(' OK?'/)
17500 ACCEPT 1001,NA
17600 IF(NA.EQ.'N')GO TO 168
17700 JX=NX/JPL
17800 JY=NY/JPL
17900 IF(PLT.NE.0)GO TO 657
18000 6852 CALL CLRPOG(2)
18100 CALL SETPOG(1)
18200 CC JA=-380
18300 CC JB=-200
18400 CALL JZERO
18500 CALL AIVECT(-380,-200)
18600 GO TO 685
19000 657 FORMAT(' OUTER LIMITS')
19100 TYPE 65,MA,MC,MB,MD
19200 C OUTER COORDINATES
19300 50 FORMAT(' DO YOU WANT THE FRAME ?'/)
19400 1681 TYPE 50
19500 65 FORMAT(' LFT=',I4,' RT=',I4,' BOT=',I4,' TOP=',I4)
19600 ACCEPT 1001,ALFAB
19700 IF(NEWX.NE.-1)CALL PLOTS(I)
19800 681 PLT=-1
19900 IF(ALFAB.NE.'Y') GOTO 685
20000 JX=NX
20100 JY=NY
20200 JA=0
20300 JB=0
20400 CALL DSTORT(JPL)
20500 CALL LINES(3)
20600 JA=MC
20700 JB=0
20800 CALL LINES(2)
20900 JA=MC
21000 JB=MD
21100 CALL LINES(2)
21200 JA=0
21300 JB=MD
21400 CALL LINES(2)
21500 JA=0
21600 JB=0
21700 CALL LINES(2)
21800 685 JAR=0
21900 JBR=0
22200 JREV=MC/JPL
22300 JINV=MD/JPL
22400 IF(CONST)PLT=-2
22410 CALL DSTORT(JPL)
22500 CALL PLTMAN
22600 NEWX=-1
22700 NX=JQX
22800 NY=JQY
22900 WX=0
23000 IF(PLT)CALL PLOT(0,0,3)
23050 NEWEND=0
23100 END